home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 86 / pascal / cursdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-19  |  9.5 KB  |  392 lines
  1. Program cursordemo(Input,Output);
  2.  
  3. (* This program was written as a demo of the cursor routines OSS
  4.    posted in their BBS. If you are writing Pascal programs with
  5.    GEM boxes, you can quit now.
  6.  
  7.    Since the Atari ST screen emulates VT-52, putting the VT-52
  8.    escape sequence to the screen via BIOS calls can achieve the
  9.    purpose of controlling cursor movement. By using these routine
  10.    a programmer can write a TOS program without learing GEM calls
  11.    and yet make the program interface acceptable. People may find
  12.    out the interface is IBMish and may not like it, especially
  13.    for those who own a ST as the first computer in life. However,
  14.    if you are porting programs from Turbo Pascal, or write some
  15.    quick routines for yourself, these routines are worth to be used.
  16.  
  17.    I add five more procedures to OSS's CURSOR.PAS. They are quite
  18.    useful and I don't know why OSS forgot to put them in.
  19.  
  20.    The following program is intent to show how to use these
  21.    procedures and how the interface will look like. Only half of
  22.    the procedures are used in the demo but the rest of them are
  23.    easy to be used.
  24.  
  25.    Leave comments to me via GEnie (  J.CHEN ) or CompuServe
  26.    [72327,2434], or just call my BBS (MANIAC) at 207-854-2687
  27.  
  28.    Acknowledge should be made to Tim Harvey who wrote the text
  29.    color routines.
  30.  
  31.                                       Jinfu Chen
  32.  
  33. *)
  34.  
  35.  
  36. Const
  37.   cont ='  Hit Return to continue ...';
  38.  
  39. Var
  40.   count,row,column : Integer;
  41.   selection        : Char;
  42.  
  43. (*$I cursor.pas*)
  44.  
  45. Procedure delay(delay_time : Long_Integer);
  46.  
  47. (* a very handy routine to delay time in two seconds multiple,
  48.    remember how to do it in BASIC: for I = 1 to 2000? Even to
  49.    20000 the ST is still too fast, thanks to the 8 Mhz 68000. *)
  50.  
  51. Var
  52.   first_time : Long_integer;
  53.  
  54. Begin  (* delay *)
  55.   first_time := clock;
  56.   Repeat
  57.     ;
  58.     Until (clock-first_time) > delay_time
  59. End; (* delay *)
  60.  
  61. Procedure hold;
  62.  
  63. Begin (* hold *)
  64.   Writeln(cont);
  65.   Readln
  66. End;  (* hold *)
  67.  
  68. Function Getrez : Integer;
  69. XBIOS(4) ;
  70. (* check screen resolution *)
  71.  
  72.  
  73.  
  74. Procedure show_off;
  75. Begin (* show_off *)
  76.   GotoXy(6,1);
  77.   Writeln('                     Cursor Routing Demo');
  78.   Writeln('                 by Jinfu Chen and Tim Harvey');
  79.   Writeln('                      November 28, 1986');
  80.   Writeln('                      in Personal Pascal');
  81.   Writeln('                 Portions of the program are');
  82.   Writeln('                copyrighted ',chr(189),' by OSS and CCD ')
  83. End;  (* show_off *)
  84.  
  85. Procedure menu;
  86.  
  87. (* Here comes the IBMish screen *)
  88.  
  89. Begin (* menu *)
  90.   ClrScr;
  91.   GotoXY(3,10);
  92.   InverseVideo;
  93.   Writeln('                            ');
  94.   GotoXy(4,10);
  95.   Writeln('        Main Menu           ');
  96.   GotoXy(5,10);
  97.   Writeln('                            ');
  98.  
  99.   GotoXY(8,8);
  100.   InverseVideo;
  101.   Write(' 1 ');
  102.   NormVideo;
  103.   Writeln(' Clear Routing');
  104.  
  105.   GotoXY(10,8);
  106.   InverseVideo;
  107.   Write(' 2 ');
  108.   NormVideo;
  109.   Writeln(' Cursor Movement Routing');
  110.  
  111.   GotoXY(12,8);
  112.   InverseVideo;
  113.   Write(' 3 ');
  114.   NormVideo;
  115.   Writeln(' Text Color Routing');
  116.  
  117.   GotoXY(14,8);
  118.   InverseVideo;
  119.   Write(' 0 ');
  120.   NormVideo;
  121.   Writeln(' Quit' );
  122.  
  123.   GotoXY(18,8);
  124.   InverseVideo;
  125.   Write(' Enter your choice ==> ');
  126.   GotoXY(18,33);
  127.   NormVideo;
  128.   Read(selection)
  129.  
  130. End;  (* menu *)
  131.  
  132. Procedure clear;
  133.  
  134. (* some clear procedures *)
  135. Var
  136.   count : Integer;
  137.  
  138. Begin (* clear *)
  139.   ClrScr;
  140.   Writeln('  In this section, we learn how to use clear screen rountines');
  141.   GotoXy(5,1);
  142.   Writeln('  The first one is ClrScr, Clear Screen. This one erases the');
  143.   Writeln('  whole screen.');
  144.   Delay(2);
  145.   ClrScr;
  146.   Delay(3);
  147.  
  148.   Writeln('  In this section, we learn how to use clear screen rountines');
  149.   GotoXy(5,1);
  150.   Writeln('  The next one is ClrEol, Clear from cursor to the');
  151.   Writeln('  End of line.');
  152.   GotoXy(5,25);
  153.   Delay(4);
  154.   ClrEol;
  155.   Delay(3);
  156.  
  157.   GotoXy(5,1);
  158.   Writeln('  We can also use ClrStart to clear from the start of a ');
  159.   Writeln('  line to the cursor.');
  160.   GotoXy(5,25);
  161.   Delay(4);
  162.   ClrStart;
  163.   Delay(3);
  164.  
  165.   GotoXY(7,1);
  166.   Writeln('  ClrLine erases a line and leaves the rest of text intact.');
  167.   GotoXY(6,1);
  168.   Delay(4);
  169.   ClrLine;
  170.   Delay(3);
  171.  
  172.   GotoXy(5,1);
  173.   Writeln('  The next one is ClrEos, Clear from cursor to the End of line.');
  174.   Writeln;
  175.   Writeln('  Let us put some garbage in the screen first then erase them.');
  176.   For count := 8 To 23 Do
  177.     Begin (* for *)
  178.       GotoXy(count,1);
  179.       Writeln(' GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG');
  180.     End;  (* for *)
  181.   GotoXy(8,1);
  182.   Delay(4);
  183.   ClrEos;
  184.   Delay(3);
  185.  
  186.   GotoXY( 5, 1 );
  187.   ClrLine;
  188.   Writeln('  You can clear the screen from the top to the cursor by ');
  189.   Writeln('  using ClrToCurs.');
  190.   GotoXY( 4, 1);
  191.   Delay(4);
  192.   ClrToCurs;
  193.   Delay(3);
  194.  
  195. End;  (* clear *)
  196.  
  197. Procedure curs_move;
  198. Var
  199.   count : Integer;
  200. Begin (* curs_move *)
  201.   ClrScr;
  202.   Writeln('  This section shows how to use cursor movement routines.');
  203.   GotoXy(10,1);
  204.   Write('CursUp moves cursor up.');
  205.   Delay(1);
  206.   For count := 1 To 3 Do
  207.     Begin (* for *)
  208.       Delay(1);
  209.       CursUp;
  210.     End;  (* for *)
  211.   Delay(1);
  212.  
  213.   Write('CursDown moves cursor down.');
  214.   For count := 1 To 3 Do
  215.     Begin (* for *)
  216.       Delay(1);
  217.       CursDown;
  218.     End;  (* for *)
  219.   Delay(1);
  220.  
  221.   GotoXy(12,1);
  222.   Write('The similar is  CursRight.');
  223.   For count := 1 To 3 Do
  224.     Begin (* for *)
  225.       Delay(1);
  226.       CursRight;
  227.     End;  (* for *)
  228.   Delay(1);
  229.  
  230.   Write('And CursLeft.');
  231.   For count := 1 To 3 Do
  232.     Begin (* for *)
  233.       Delay(1);
  234.       CursLeft;
  235.     End;  (* for *)
  236.   Delay(1);
  237.  
  238.  
  239.   GotoXy(15,1);
  240.   ClrEos;
  241.   Writeln('  Now we will try a very useful one, GotoXy(row,column)');
  242.   Write('  Which row do you want me to move to (1-24) ? '); readln(row);
  243.   Write('  Which column do you want me to move to (1-80) ? '); readln(column);
  244.   GotoXy(row,column);
  245.   Delay(3);
  246.  
  247.   GotoXY(10,1);
  248.   ClrEos;
  249.   Writeln('  The next two procedures, SaveCurs and ResCurs, can be');
  250.   Writeln('  used to save a position of the cursor and restore it ');
  251.   Writeln('  later on.');
  252.   Delay(4);
  253.   Writeln('  Let us move the cursor to row ten and column one and ');
  254.   Writeln('  save it.');
  255.   GotoXY(10,1);
  256.   SaveCurs;
  257.   Delay(3);
  258.   Writeln('  Now move it around...');
  259.   For count := 1 To 3 Do Begin
  260.     CursUp;
  261.     Delay(1);
  262.   End;
  263.   For count := 1 To 3 Do Begin
  264.     CursRight;
  265.     Delay(1);
  266.   End;
  267.   For count := 1 To 3 Do Begin
  268.     CursDown;
  269.     Delay(3);
  270.   End;
  271.   Writeln('  and restore it back.');
  272.   Delay(4);
  273.   ResCurs;
  274.   Delay(3);
  275.  
  276. End;  (* curs_move *)
  277.  
  278.  
  279. Procedure show_text;
  280.  
  281. VAR     CHOICE :  CHAR;
  282.  
  283.  
  284. PROCEDURE show_MENU;
  285.  
  286. BEGIN
  287.      GOTOXY( 9,1 );
  288.      WRITELN('                                                  ');
  289.      WRITELN('       Which screen would you like to see?        ');
  290.      WRITELN('                                                  ');
  291.      WRITELN('         1   Green Screen with Black Text         ');
  292.      WRITELN('         2   Black Screen with Red Text           ');
  293.      WRITELN('         3   White Screen with Green Text         ');
  294.      WRITELN('         4   Black Screen with White Text         ');
  295.      WRITELN('         5   Red Screen with Black Text           ');
  296.      WRITELN('         6   White Screen with Red Text           ');
  297.      WRITELN('         7   I have had enough, thanks!           ');
  298.      WRITELN('                                                  ');
  299.      WRITELN('                Enter Your Selection:             ');
  300.      WRITELN('                                                  ');
  301.      READ(CHOICE);
  302. END; { MENU }
  303.  
  304.  
  305. PROCEDURE SET_COLOR;
  306.  
  307.  
  308. BEGIN
  309.   CASE CHOICE OF
  310.     '1' : BEGIN
  311.             CLRSCR;
  312.             TEXTBACKGROUND (2);
  313.             TEXTCOLOR (3)
  314.           END;
  315.     '2' : BEGIN
  316.             CLRSCR;
  317.             TEXTBACKGROUND (3);
  318.             TEXTCOLOR (1)
  319.           END;
  320.     '3' : BEGIN
  321.             CLRSCR;
  322.             TEXTBACKGROUND (0);
  323.             TEXTCOLOR (2)
  324.           END;
  325.     '4' : BEGIN
  326.             CLRSCR;
  327.             TEXTBACKGROUND(3);
  328.             TEXTCOLOR(0);
  329.           END;
  330.     '5' : BEGIN
  331.             CLRSCR;
  332.             TEXTBACKGROUND(1);
  333.             TEXTCOLOR(3);
  334.           END;
  335.     '6' : BEGIN
  336.             TEXTBACKGROUND(0);
  337.             TEXTCOLOR(1);
  338.           END;
  339.   END { CASE }
  340. END; { SET_COLOR }
  341.  
  342.  
  343. BEGIN { MAIN SHOW_TEXT }
  344.   CURSOFF;
  345.   WHILE CHOICE <> '7' DO
  346.     BEGIN
  347.       CLRSCR;
  348.       show_MENU;
  349.       if (choice in ['1','2','3','4','5','6','7']) then
  350.       SET_COLOR
  351.     END; {WHILE}
  352.   NORMVIDEO;
  353.   TEXTCOLOR(3);
  354.   TEXTBACKGROUND(0);
  355.   CURSON;
  356.   CLRSCR
  357. END; (* show_text *)
  358.  
  359.  
  360. Begin (* main *)
  361.   If Getrez = 0 Then Begin
  362.     Writeln('  It is better to run this ');
  363.     Writeln('  program in medium resolution!');
  364.     hold;
  365.   End; (* getrez *)
  366.   CrtInit;        (* not as neccessery as Init_Gem *)
  367.   TextColor(3);
  368.   TextBackground(2);
  369.   CursOff;        (* like Hide_Mouse *)
  370.   selection := '9';
  371.   ClrScr;
  372.   Show_off;
  373.   Delay(4);
  374.   CursOn;         (* and like Show_Mouse *)
  375.   While selection <> '0' Do
  376.     Begin (* while *)
  377.       Menu;
  378.       If (selection In ['1','2','3','4']) Then  (* trap input error*)
  379.       Case selection Of
  380.         '1' : Clear;
  381.         '2' : Curs_move;
  382.         '3' : Show_text;
  383.         '4' : Menu
  384.       End; (* case *)
  385.     End; (* while *)
  386.   NormVideo;           (* don't forget to reset the screen back *)
  387.   TextColor(3);
  388.   TextBackground(0);
  389.   ClrScr;
  390.   CrtExit;
  391. End.  (* main *)
  392.